unit uWindowsEx;

interface

uses windows, graphics, CommDlg, Dialogs, ShlObj, Controls;

function WindowsMessageBox(const Msg, Caption: string; UType: Cardinal;
  Parent: HWND): integer;

function WindowsChooseColor(Parent: HWND; var Color: tcolor): boolean;

function WindowsSelectDir(Handle: HWND; const InitDirName, Title: string)
  : string;

function GetTopWinControl(Ctl: TWinControl): TWinControl;

implementation

uses forms;

var
  GlobalParent: HWND;
  GlobalMessageBoxHook: HHOOK;

  CustomColorsArray: TCustomColors;

function WindowsSelectDir(Handle: HWND; const InitDirName, Title: string)
  : string;
var
  r: TBrowseInfo;
  lpItemID: PItemIDList;
  DisplayName: array [0 .. MAX_PATH] of char;
  TempPath: array [0 .. MAX_PATH] of char;
begin
  ZeroMemory(@r, sizeof(r));
  r.hwndOwner := Handle;
  r.pidlRoot := nil;
  ZeroMemory(@DisplayName, length(DisplayName) * sizeof(char));
  Move(InitDirName, DisplayName[0], length(InitDirName));
  r.pszDisplayName := @DisplayName[0];
  r.lpszTitle := pchar(Title);
  r.ulFlags := 0;

  lpItemID := SHBrowseForFolder(r);
  if lpItemID <> nil then
  begin
    SHGetPathFromIDList(lpItemID, TempPath);
    Result := TempPath;
    GlobalFreePtr(lpItemID);
  end
  else
    Result := '';
end;

function MessageBoxHook(code: integer; wparam: wparam; lparam: lparam)
  : LRESULT stdcall;
var
  PntR, BoxR: TRect;
  BoxWnd: HWND;
  x, y, w, h: integer;
begin
  if code = HCBT_ACTIVATE then
  begin
    if GlobalParent <> 0 then
    begin
      GetWindowRect(GlobalParent, PntR);
      BoxWnd := wparam;
      GetWindowRect(BoxWnd, BoxR);
      w := BoxR.Right - BoxR.Left;
      h := BoxR.Bottom - BoxR.Top;
      x := PntR.Left + (PntR.Right - PntR.Left - w) div 2;
      y := PntR.Top + (PntR.Bottom - PntR.Top - h) div 2;
      if (x > 0) and (y > 0) and (x < Screen.Width) and (y < Screen.Height) then
        SetWindowPos(BoxWnd, GlobalParent, x, y, w, h,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
    end;
    UnhookWindowsHookEx(GlobalMessageBoxHook);
    Result := 0;
  end
  else
    Result := CallNextHookEx(0, code, wparam, lparam);
end;

function WindowsMessageBox(const Msg, Caption: string; UType: Cardinal;
  Parent: HWND): integer;
begin
  if UType = 0 then
    UType := MB_ICONINFORMATION;
  GlobalParent := Parent;
  GlobalMessageBoxHook := SetWindowsHookEx(WH_CBT, @MessageBoxHook, 0,
    GetCurrentThreadId);
  Result := MessageBox(Parent, pchar(Msg), pchar(Caption), UType);
end;

function WindowsChooseColor(Parent: HWND; var Color: tcolor): boolean;
var
  ChooseColorRec: TChooseColor;
begin
  with ChooseColorRec do
  begin
    ZeroMemory(@ChooseColorRec, sizeof(ChooseColorRec));
    lStructSize := sizeof(ChooseColorRec);
    hwndOwner := Parent;
    hInstance := SysInit.hInstance;
    rgbResult := ColorToRGB(Color);
    lpCustColors := @CustomColorsArray;

    GlobalParent := Parent;
    GlobalMessageBoxHook := SetWindowsHookEx(WH_CBT, @MessageBoxHook, 0,
      GetCurrentThreadId);
    Result := ChooseColor(ChooseColorRec);
    Color := rgbResult;
    Move(lpCustColors^, CustomColorsArray[0], sizeof(CustomColorsArray));
  end;
end;

function GetTopWinControl(Ctl: TWinControl): TWinControl;
begin
  Result := Ctl;
  while Result.Parent <> nil do
    Result := Result.Parent;
end;

procedure InitCustomColors;
var
  i: integer;
begin
  for i := 0 to MaxCustomColors - 1 do
    CustomColorsArray[i] := ColorToRGB(clWhite);
end;

initialization

InitCustomColors;

end.
